Shareware Grab Bag/Shareware Grab Bag.iso/007/day.arc/DAY.PAS

Pascal/Delphi Source File | 1985-08-24 | 6KB | 223 lines

program DAY(Con);


   {DAY.PAS #1.00 85-08-17 ORDINAL AND CALENDAR DAY REPORT UTILITY

            V01 L00 derived on 85-08-17 by Dennis E. Hamilton, to make
                    it easy to check on any dates handled by DAYLIB.PLB.
                    Some of the basic helper routines were cloned from
                    DAYTST.PAS #3.00 earlier this day.


    The program DAY provides information about the day number or calendar
    date given as its command-line parameter.  Operating the program with
    no parameters provides an usage summary.
                                                           }


{$I DAYLIB.PLB } {vintage 3.00 calendar/ordinal-date conversion routines}


procedure

   out2dig(i: integer);

   begin {Display the specified value as a 2-digit numeric field}
   if i < 10
   then write(CON, '0', i :1)
   else write(CON,      i :2);
   end {out2dig};


procedure

   OutCalForm(date: calday);

   begin {Display the specified value as a yyyy-mm-dd form}
   out2dig(date.year);
   write(CON, '-');
   out2dig(date.mo);
   write(CON, '-');
   out2dig(date.da);
   end {OutCalForm};


procedure

   OutFacts(day: integer);

   var date: calday {intermediate value};

   begin {Specify qualities of the specified ordinal date}

   write(CON, 'day ', day :1, ' is for ');
   case WeekDay(day)
     of 0: write(CON, 'Sunday');
        1: write(CON, 'Monday');
        2: write(CON, 'Tuesday');
        3: write(CON, 'Wednesday');
        4: write(CON, 'Thursday');
        5: write(CON, 'Friday');
        6: write(CON, 'Saturday');
      end;

   write(CON, ', ');
   CalDate(date, day);
   OutCalForm(date);
   writeln(CON, '.');

   end {OutFacts};

procedure

   OutItem(v: integer {calendar-entry item} );

   begin
   if v = 0
   then write(CON, '   .')
   else write(CON, v :4);
   end {OutItem};

const maxw = 42;
             {lowest spot NEVER needed on a rectangular calendar page}

var ordnum: integer {ordinal date of the input};
      date: calday {Gregorian date given as input};
         i: integer {working counter};
         k: integer {calendar page column counter};
       cmo: integer {current-month variable for comparison};
       chk: integer {used for error-code determination};
        np: integer {number of parameters presumed};

  monthday: array [0 .. maxw] of byte
            {table used to lay out a calendar page};


BEGIN {DAY}

rewrite(CON);
CrtInit;

np := ParamCount;
chk := 0;

if np = 1
then Val(ParamStr(1), ordnum, chk);

if np > 1
then begin
     Val(ParamStr(1), date.year, chk);
     if chk = 0
     then begin
          Val(ParamStr(2), i, chk);
          date.mo := i;
          date.da := 0;
          if (ParamCount > 2) and (chk = 0)
          then begin
               Val(ParamStr(3), i, chk);
               date.da := i;
               end;
          end;
     end;

if (chk = 0) and (np = 1)
then CalDate(date, ordnum);

if (chk = 0) and (np > 0)
then if BadDate(date)
     then chk := 1;

if chk = 0 then ClrScr;
writeln(CON, 'DAY> #1.00 85-08-17 ORDINAL-GREGORIAN DATE-CHECK UTILITY');
writeln(CON, '     CompuServe Forum edition by Dennis E. Hamilton');
writeln(CON);

if chk <> 0
then begin
     write(CON, '     +++ Invalid Parameter Value: ');
     for i := 1 to np
      do write(CON, ParamStr(i), ' ');
     writeln(CON, #7);
     writeln(CON, #7);
     end;

if np = 0 then chk := 1;
if chk <> 0
then begin
     writeln(CON, '     A0>DAY ordnum             reports facts about the');
     writeln(CON, '                               ordnum parameter, taken');
     writeln(CON, '                               as number of days since');
     writeln(CON, '                               1977 12 31.');
     writeln(CON);
     writeln(CON, '     A0>DAY year mo da         reports facts about the');
     writeln(CON, '                               Gregorian date given in');
     writeln(CON, '                               the range 1888 04 13 to');
     writeln(CON, '                               2067 09 17.');
     writeln(CON);
     end;

if chk = 0
then begin
     ordnum := since77(date);
     writeln(CON);
     write  (CON, '     ');
     OutFacts(ordnum);
     writeln(CON);
     writeln(CON);
     case date.mo
       of 1: write(CON, '                 January');
          2: write(CON, '                February');
          3: write(CON, '                   March');
          4: write(CON, '                   April');
          5: write(CON, '                     May');
          6: write(CON, '                    June');
          7: write(CON, '                    July');
          8: write(CON, '                  August');
          9: write(CON, '               September');
         10: write(CON, '                 October');
         11: write(CON, '                November');
         12: write(CON, '                December');
        end;

     writeln(CON, date.year :6);

     writeln(CON);

     writeln      (CON, '          Su  Mo  Tu  We  Th  Fr  Sa');
     writeln(CON);

     for i := 0 to maxw do monthday[i] := 0;
        {clearing all calendar buckets to zero for starters};

     date.da := 1;
     cmo := date.mo;
     ordnum := since77(date);
     i := weekday(ordnum);
        {setting up for first of month in monthday list};

     repeat
        monthday[i] := date.da;
        ordnum := succ(ordnum);
        i := succ(i);
        CalDate(date, ordnum);
        until date.mo <> cmo;

     i := 0;
     repeat
        write(CON, '        ');
        for k := 1 to 7
         do begin
            OutItem(monthday[i]);
            i := succ(i);
            end;
        writeln(CON);
        until monthday[i] = 0;

     writeln(CON);
     end;

CrtExit;
close(CON);

END. {DAY}